home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / ms_dos / happysrc / pccall.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-07-08  |  41.5 KB  |  1,041 lines
  1. /*********************************************************************
  2.  *
  3.  *    *** HAPPy Pascal compiler ***
  4.  *
  5.  *      procedure or function call
  6.  *        (主に標準手続き､標準関数)
  7.  *
  8.  *     void call(Set fsys,ctp *fcp)
  9.  *
  10.  *        Copyright (c) H.Asano 1992.
  11.  *
  12.  **********************************************************************/
  13.  
  14. #define EXTERN extern
  15. #include "pascomp.h"
  16. #include "pcpcd.h"
  17.  
  18. /***********************************/
  19. /* 標準手続き･標準関数名の識別子   */
  20. /***********************************/
  21. typedef enum stdpf
  22. {
  23.     /** 標準手続き **/
  24.              spWRITE,                   /* write                      */
  25.              spWRITELN,                 /* writeln                    */
  26.              spREAD,                    /* read                       */
  27.              spREADLN,                  /* readln                     */
  28.              spPAGE,                    /* page                       */
  29.              spGET,                     /* get                        */
  30.              spPUT,                     /* put                        */
  31.              spRESET,                   /* reset                      */
  32.              spREWRITE,                 /* rewrite                    */
  33.              spNEW,                     /* new                        */
  34.              spDISPOSE,                 /* dispose                    */
  35.              spPACK,                    /* pack                       */
  36.              spUNPACK,                  /* unpack                     */
  37.     /** 標準関数   **/
  38.              sfABS,                     /* abs                        */
  39.              sfSQR,                     /* sqr                        */
  40.              sfTRUNC,                   /* trunc                      */
  41.              sfROUND,                   /* round                      */
  42.              sfODD,                     /* odd                        */
  43.              sfORD,                     /* ord                        */
  44.              sfCHR,                     /* chr                        */
  45.              sfPRED,                    /* pred                       */
  46.              sfSUCC,                    /* succ                       */
  47.              sfEOLN,                    /* eoln                       */
  48.              sfEOF,                     /* eof                        */
  49.              sfSIN,                     /* sin                        */
  50.              sfCOS,                     /* cos                        */
  51.              sfEXP,                     /* exp                        */
  52.              sfSQRT,                    /* sqrt                       */
  53.              sfLN,                      /* ln                         */
  54.              sfARCTAN,                  /* arctan                     */
  55. } stdpf ;
  56.  
  57.  
  58. /********** 関数のプロトタイプ宣言 **********/
  59.  
  60. extern void calluser(Set,ctp*) ;
  61. extern void expression(Set) ;
  62. extern void selector(Set,ctp*) ;
  63. extern ctp  *searchid(Set)  ;
  64. extern Set  *mkset(Set*,int,...) ;
  65. extern Set  *orset(Set*,Set*);
  66. extern void enterid(ctp*)    ;
  67. extern ctp  *mkctp(char*,enum idclass,stp*,ctp*) ;
  68. extern void pcerr(int,char*) ;
  69. extern void insymbol(void)   ;
  70. extern boolean string(stp*)  ;
  71. extern boolean compatible(stp*,stp*) ;
  72. extern boolean assigncompati(stp*,stp*) ;
  73. extern void checkbounds(stp*,int) ;
  74. extern void getbounds(stp*,long*,long*) ;
  75. extern void constant(Set, stp**, union valu*); 
  76. extern int align(stp*,int) ;
  77. extern void gen0(enum pcdmnc)     ;
  78. extern void gen1(enum pcdmnc, int) ;
  79. extern void gen0t(enum pcdmnc,stp*) ;
  80. extern void gen1t(enum pcdmnc,stp*,int) ;
  81. extern void gen2t(enum pcdmnc,stp*,int,int) ;
  82. extern void gencsp(enum pcdprmnc) ;
  83. extern void genldc(char,long) ;
  84. extern void genlda(int,int)   ;
  85. extern void genixa(long,int)  ;
  86. extern void genchk(stp*,int,long,long) ;
  87. extern void convertint(stp*)  ;
  88. extern void load(void) ;
  89. extern void loadaddress(void) ;
  90. extern void store(attr) ;
  91. extern void skip(Set) ;
  92.  
  93. static void pwrite(char*,Set,stdpf) ;
  94. static void textwrite(Set,char*,attr)    ;
  95. static void nottextwrite(Set,char*,attr) ;
  96. static void pread(char*,Set,stdpf)  ;
  97. static void nottextread(Set,char*,attr)  ;
  98. static void ppage(char*,Set) ;
  99. static void pgetputrstrwt(char*,Set,stdpf);
  100. static void pnewdis(char*,Set,stdpf);
  101. static void ppack(char*,Set) ;
  102. static void punpack(char*,Set) ;
  103. static void variable(Set)   ;
  104. static void fabs(char*) ;
  105. static void fsqr(char*) ;
  106. static void ftrunc(char*) ;
  107. static void fround(char*) ;
  108. static void fodd(char*) ;
  109. static void ford(char*) ;
  110. static void fchr(char*) ;
  111. static void fpredsucc(char*,stdpf) ;
  112. static void feofeoln(char*,Set,stdpf)   ;
  113. static void fcalc(char*,stdpf) ;
  114. static void enterstdpf_sub(char*,enum idclass,stp*,stdpf) ;
  115.  
  116. /*********************************************************************/
  117.  
  118. /***************************************/
  119. /*  call() : 手続き･関数の呼出処理     */
  120. /***************************************/
  121. void call(Set fsys,ctp *fcp)
  122. {
  123.   int lkey ;
  124.   char *name ;                          /* 手続き名(エラーメッセージ用)*/
  125.   Set ws   ;
  126.  
  127.      if(fcp->n.pf.pfdeckind == standard) {  /* 標準手続きor標準関数の時 */
  128.       lkey = fcp->n.pf.sd.key ;
  129.       name = fcp->name        ;
  130.       if(fcp->klass == proc) {          /* 手続きの時                 */
  131.        mkset(&ws,spWRITE,spWRITELN,spREAD,spREADLN,spPAGE,-1);
  132.        if(! inset(ws,lkey))      /* write,writeln,read,readln,page以外*/
  133.         if(sy == lparent) insymbol() ;
  134.         else pcerr(9,"") ;              /* ( がない                   */
  135.  
  136.        switch(lkey) {
  137.         case spWRITE   :
  138.         case spWRITELN :  pwrite(name,fsys,lkey) ;  break ;
  139.         case spREAD    :
  140.         case spREADLN  :  pread(name,fsys,lkey) ;   break ;
  141.         case spPAGE    :  ppage(name,fsys) ;        break ;
  142.         case spGET     :
  143.         case spPUT     :
  144.         case spRESET   :
  145.         case spREWRITE :  pgetputrstrwt(name,fsys,lkey) ;  break ;
  146.         case spNEW     :
  147.         case spDISPOSE :  pnewdis(name,fsys,lkey) ;  break ;
  148.         case spPACK    :  ppack(name,fsys) ;  break ;
  149.         case spUNPACK  :  punpack(name,fsys) ; break ;
  150.        }
  151.  
  152.        if(! inset(ws,lkey))      /* write,writeln,read,readln,page以外*/
  153.         if(sy == rparent) insymbol() ;
  154.         else pcerr(4,"") ;              /* ) がない　                 */
  155.       }
  156.  
  157.       else {                            /* 標準関数の時               */
  158.        ws = fsys ;
  159.        addset(ws,rparent) ;
  160.        if((lkey != sfEOLN) && (lkey != sfEOF)) { /* eoln,eof以外は(がある*/
  161.         if(sy == lparent) insymbol() ;
  162.         else pcerr(9,"") ;              /* ( がない                   */
  163.         expression(ws)   ;              /* 引数の処理                 */
  164.         load()           ;              /* 引数をload                 */
  165.        }
  166.  
  167.        switch(lkey) {                   /* 関数により振り分ける       */
  168.         case sfABS  : fabs(name)   ; break;
  169.         case sfSQR  : fsqr(name)   ; break;
  170.         case sfTRUNC: ftrunc(name) ; break;
  171.         case sfROUND: fround(name) ; break;
  172.         case sfODD  : fodd(name)   ; break;
  173.         case sfORD  : ford(name)   ; break;
  174.         case sfCHR  : fchr(name)   ; break;
  175.         case sfPRED :
  176.         case sfSUCC : fpredsucc(name,lkey)   ; break;
  177.         case sfEOLN :
  178.         case sfEOF  : feofeoln(name,ws,lkey) ; break;
  179.         case sfSIN  :
  180.         case sfCOS  :
  181.         case sfEXP  :
  182.         case sfSQRT :
  183.         case sfLN   :
  184.         case sfARCTAN: fcalc(name,lkey) ;break;  /* 算術関数          */
  185.        } 
  186.  
  187.        if((lkey != sfEOLN) && (lkey != sfEOF))  /* eoln,eof以外は)がある*/
  188.         if(sy == rparent) insymbol() ;
  189.         else pcerr(4,"") ;              /* ) がない                   */
  190.         
  191.       }
  192.      }
  193.  
  194.      else calluser(fsys,fcp) ;          /* ユーザ定義の手続き･関数を呼ぶ*/
  195. }
  196.  
  197. /*****************************************/
  198. /* cspfile():ファイル入出力関係の命令生成*/
  199. /*****************************************/
  200. static void cspfile(attr fattr,enum pcdprmnc mnc)
  201. {
  202.      if(fattr.access == drct)           /* ファイル変数が実変数の時   */ 
  203.       genlda(level-fattr.vlevel, fattr.dplmt);
  204.      else                              /* ファイル変数が変数引数      */ 
  205.       gen2t(iLOD,nilptr,level-fattr.vlevel,fattr.dplmt) ;
  206.      gencsp(mnc) ;                     /* csp命令生成                 */
  207. }
  208.  
  209. /***************************************/
  210. /* pwrite() : write/writeln手続きの処理*/
  211. /***************************************/
  212. void pwrite(char *name,Set fsys,stdpf fkey)
  213. {
  214.   stp *lsp ;
  215.   attr fileattr ;
  216.   boolean test ;
  217.   boolean textflag;
  218.   Set ws,ws1 ;
  219.  
  220.      fileattr.access = drct ;
  221.      fileattr.vlevel = 1 ;              /* ファイル変数省略時は       */
  222.      fileattr.dplmt  = outputadr ;      /* outputファイルを割り当てる */
  223.      textflag = true    ;
  224.      mkset(&ws,comma,colon,rparent,-1) ;
  225.      orset(&ws,&fsys) ;
  226.  
  227.      if(sy == lparent) {                /* ( がきたら引数がある       */
  228.       insymbol() ;
  229.       expression(ws) ;                  /* 最初の式                   */
  230.       lsp = gattr.typtr ;
  231.       test = false ; 
  232.       if(lsp)
  233.        if(lsp->form == files) {         /***** ファイル変数の処理 *****/
  234.         fileattr = gattr ;              /* ファイル変数の属性を退避   */
  235.         if(fileattr.access == indrct)   /* 変数引数だった時           */
  236.          gen2t(iSTR,nilptr,level-fileattr.vlevel,fileattr.dplmt) ;
  237.        /* すでにlodaが生成されてしまっているのでスタックポインタを戻す*/
  238.         if(!lsp->sf.fi.texttype) {      /*テキストファイルでない      */
  239.          textflag = false ;
  240.          if(fkey == spWRITELN) pcerr(116,name) ;/* writelnはテキストのみ*/
  241.         }
  242.         if(sy == rparent) {
  243.          if(fkey == spWRITE) pcerr(116,name) ; /* writeの時は)は駄目  */
  244.          test = true ;                  /* 処理終わり                 */
  245.         }
  246.         else if(sy == comma) {          /* ファイル変数に次ぐ文字が , */
  247.          insymbol() ; 
  248.          expression(ws) ;               /* 出力対象式                 */
  249.         }
  250.         else {                          /* ) , 以外                   */
  251.          pcerr(116,name);               /* 標準手続きの引数に誤り     */
  252.          mkset(&ws1,comma,rparent);
  253.          orset(&ws1,&fsys);
  254.          skip(ws1) ;                    /* 読み飛ばし                 */
  255.         }
  256.        }
  257.        else if(!defineoutput) pcerr(301,name) ; /* ファイル変数省略時
  258.                                                   outputが未定義ならエラー*/
  259.  
  260.       if(! test)
  261.        if(textflag) 
  262.         textwrite(ws,name,fileattr);        /*  出力対象式の処理      */
  263.        else 
  264.         nottextwrite(fsys,name,fileattr);   /* テキスト以外への出力   */
  265.  
  266.       if(sy == rparent) insymbol() ;
  267.       else pcerr(4,"") ;
  268.      }
  269.  
  270.      else                               /* (がない ･･･ 引数がない     */
  271.       if(fkey == spWRITE) pcerr(116,name) ;   /* writeは必ず引数が必要*/
  272.       else if(!defineoutput) pcerr(301,name) ;/* output未定義は駄目   */
  273.  
  274.      if(fkey == spWRITELN)
  275.       cspfile(fileattr,pWLN) ;
  276. }
  277.  
  278. /***************************************/
  279. /* textwrite() : text型への出力        */
  280. /***************************************/
  281. static void textwrite(Set fsys,char *fname,attr fattr)
  282. {
  283.   stp *lsp;
  284.   int len ;
  285.   boolean defaultcolum  ;               /* default 桁数の時 true      */
  286.   boolean test          ;
  287.   Set ws                ;
  288.  
  289.      do {
  290.       defaultcolum = true ;
  291.  
  292.       lsp = gattr.typtr ;
  293.       if(lsp)
  294.        (lsp->form <= subrange) ? load() : loadaddress() ;
  295.  
  296.        if(sy==colon) {                  /* 桁数指定がある時           */
  297.         insymbol() ;                    /* 桁数を読む                 */
  298.         expression(fsys) ;              /* 桁数の処理                 */
  299.         if(gattr.typtr)
  300.          if(gattr.typtr != intptr)
  301.           pcerr(116,fname) ;            /* 標準手続きの引数の型誤り   */
  302.          load() ;                       /* 桁数をload                 */
  303.          defaultcolum = false ;         /* 桁数指定あり               */
  304.        }
  305.  
  306.        if(lsp == intptr) {              /* 整数型                     */
  307.         if(defaultcolum) genldc('i',12L); /* 桁数省略時  12桁         */
  308.         cspfile(fattr,pWRI) ;
  309.        }
  310.        else if(lsp == realptr) {        /* 実数型                     */
  311.         if(sy!=colon) {                 /* 固定少数点指定でない時     */
  312.          if(defaultcolum) genldc('i',14L) ; /* 桁数省略時 14桁        */
  313.           cspfile(fattr,pWRR) ;         /* csp wrr  (浮動小数点出力)  */
  314.         }
  315.         else {                          /* 固定小数点出力             */
  316.          insymbol() ;                   /* 桁数を読む                 */
  317.          expression(fsys) ;             /* 桁数の処理                 */
  318.          if(gattr.typtr)
  319.           if(gattr.typtr != intptr)
  320.            pcerr(116,fname) ;           /* 標準手続きの引数の型誤り   */
  321.          load() ;                       /* 桁数をload                 */
  322.          cspfile(fattr,pWRF) ;          /* csp wrf  (固定少数点出力)  */
  323.         }
  324.        }
  325.        else if(lsp == charptr) {        /* 文字型                     */
  326.         if(defaultcolum) genldc('i',(long)1);   /* 桁数省略時 1桁     */
  327.         cspfile(fattr,pWRC) ;
  328.        }
  329.        else if(string(lsp)) {           /* 文字列型                   */
  330.         len = lsp->size / charmax ;
  331.         if(defaultcolum) genldc('i',(long)len); /* 省略時 文字列の桁数*/
  332.         genldc('i',(long)len) ;
  333.         cspfile(fattr,pWRS) ;
  334.        }
  335.        else if(lsp == boolptr) {        /* boolean型                  */
  336.         if(defaultcolum) genldc('i',(long)5) ; /* 桁数省略時  5桁     */
  337.         cspfile(fattr,pWRB) ;
  338.        }
  339.        else pcerr(116,fname) ;          /* 標準関数の引数の型の誤り   */
  340.  
  341.        if(test = (sy == comma)) {
  342.        insymbol() ;
  343.        expression(fsys) ;               /* 次の出力対象式             */
  344.       }
  345.      } while(test) ;                    /* , なら繰り返す             */
  346. }
  347.  
  348. /*****************************************/
  349. /* nottextwrite() : テキスト型以外の出力 */
  350. /*****************************************/
  351. static void nottextwrite(Set fsys,char *fname,attr fattr)
  352. {
  353.   attr bufattr ;                        /* バッファ変数の属性         */
  354.   boolean test ;
  355.   Set ws ;
  356.  
  357.      bufattr.typtr = fattr.typtr->sf.fi.filtype ; /* バッファ変数の型 */
  358.      bufattr.kind    = varbl ;
  359.      bufattr.access  = drct  ;
  360.      bufattr.vlevel  = fattr.vlevel ;
  361.      bufattr.dplmt   = fattr.dplmt  ;
  362.      mkset(&ws,comma,rparent,-1);
  363.      orset(&ws,&fsys) ;
  364.  
  365.      do {
  366.       if(gattr.typtr)
  367.        if(gattr.typtr->form <= power)   /* スカラー､範囲､ポインタ､集合*/
  368.         load() ;
  369.        else loadaddress() ;
  370.  
  371.       if(gattr.typtr) {
  372.        if((bufattr.typtr == realptr) &&        /* バッファ変数がreal    */
  373.           (compatible(gattr.typtr,intptr))) {  /* 書くものが整数型の時  */
  374.         gen0(iFLT) ;                           /* 実数に変換 flt命令    */
  375.         gattr.typtr = realptr ;
  376.        }
  377.  
  378.        if(assigncompati(bufattr.typtr,gattr.typtr)) /* ﾊﾞｯﾌｧ変数に代入可能 */
  379.         switch(bufattr.typtr->form) {   /* 型によって振り分ける       */
  380.          case scalar   :
  381.          case subrange :
  382.            checkbounds(bufattr.typtr,18) ; /* 上限･下限のチェック     */ 
  383.            store(bufattr) ;
  384.            break ;
  385.          case pointer  :
  386.            store(bufattr) ;
  387.            break ;
  388.          case power :
  389.            checkbounds(bufattr.typtr,72) ; /* 上限･下限のチェック     */
  390.            store(bufattr) ;
  391.            break ;
  392.          case arrays  :
  393.          case records :
  394.            gen2t(iMOV,nil,1,bufattr.typtr->size) ;
  395.            break ;
  396.          case files :
  397.            pcerr(116,fname) ;           /* 標準手続きの引数誤り       */
  398.         }
  399.        else pcerr(116,fname) ;          /* 代入可能でない場合         */
  400.  
  401.        cspfile(fattr,pPUT) ;            /* csp put                    */
  402.       }
  403.  
  404.       if(test = (sy == comma)) {
  405.        insymbol() ;
  406.        expression(ws) ;               /* 次の出力対象式               */
  407.       }
  408.      } while(test) ;                  /* , なら繰り返す               */
  409. }
  410.  
  411. /***************************************/
  412. /* pread() : read/readln手続きの処理   */
  413. /***************************************/
  414. static void pread(char* name,Set fsys,stdpf fkey)
  415. {
  416.   stp *lsp ;
  417.   attr fileattr ;
  418.   boolean textflag ;
  419.   boolean test ;
  420.   Set ws ;
  421.  
  422.      fileattr.access = drct ;
  423.      fileattr.vlevel = 1 ;              /* ファイル変数省略時は       */
  424.      fileattr.dplmt  = inputadr ;       /* inputファイルを割り当てる  */
  425.      textflag = true   ;
  426.      mkset(&ws,comma,rparent,-1) ;
  427.      orset(&ws,&fsys) ;
  428.  
  429.      if(sy == lparent) {                /* ( がきたら引数がある       */
  430.       insymbol() ;
  431.       variable(ws) ;                    /* 最初の変数                 */
  432.       lsp = gattr.typtr;
  433.       test = false ;
  434.       if(lsp)
  435.        if(lsp->form == files) {         /****** file 変数の処理 *******/
  436.         fileattr = gattr ;              /* ファイル変数の属性を退避   */
  437.         if(fileattr.access == indrct)   /* 変数引数だった時           */
  438.          gen2t(iSTR,nilptr,level-fileattr.vlevel,fileattr.dplmt) ;
  439.        /* すでにlodaが生成されてしまっているのでスタックポインタを戻す*/
  440.         if(!lsp->sf.fi.texttype)  {     /* textファイル以外           */
  441.          textflag = false ;
  442.          if(fkey == spREADLN) pcerr(116,name) ;/* readlnはテキストのみ*/
  443.         }
  444.         if(sy == rparent) {
  445.          if(fkey == spREAD) pcerr(116,name) ; /* readの時は)は駄目    */
  446.          test = true ;                  /* 処理終わり                 */
  447.         } 
  448.         else if(sy != comma) {          /* ファイル変数に次ぐ文字が,でない*/
  449.          pcerr(116,name);               /* 標準手続きの引数に誤り     */
  450.          skip(ws) ;                     /* 読み飛ばし                 */
  451.         }
  452.         if(sy == comma) {
  453.          insymbol() ;
  454.          variable(ws) ;                 /* ,に続く変数の処理          */
  455.         }
  456.         else test = true ;              /* ) の時                     */
  457.        }
  458.        else if(!defineinput) pcerr(300,name) ; /* ファイル変数省略時
  459.                                                Inputが未定義ならエラー*/
  460.  
  461.       if(! test)                        /**** 読込対象変数の処理 ******/
  462.        if(textflag)                     /* テキストファイルの時       */
  463.         do {
  464.          loadaddress() ;
  465.  
  466.          if(gattr.typtr)
  467.           if(gattr.typtr->form <= subrange) 
  468.            if(compatible(intptr,gattr.typtr))
  469.             cspfile(fileattr,pRDI) ;    /* integer型なら csp rdi      */
  470.            else if(realptr == gattr.typtr)
  471.             cspfile(fileattr,pRDR) ;    /*  real型なら    csp rdr     */
  472.            else if(compatible(charptr,gattr.typtr))
  473.             cspfile(fileattr,pRDC) ;    /*  char型なら    csp rdc     */
  474.            else pcerr(116,name) ;       /* 引数の型に誤り             */
  475.           else  pcerr(116,name) ;       /* 引数の型に誤り             */
  476.            
  477.           if(test = (sy == comma)) {
  478.           insymbol() ;
  479.           variable(ws) ;                /* 次の変数の処理             */
  480.           }
  481.         } while(test) ;
  482.        else nottextread(fsys,name,fileattr); /* テキスト以外の入力    */ 
  483.  
  484.       if(sy == rparent) insymbol() ;
  485.       else pcerr(4,"") ;
  486.      }
  487.      else
  488.       if(fkey == spREAD)    pcerr(116,name) ;
  489.       else if(!defineinput) pcerr(300,name) ; /* readlnで引数がなく
  490.                                                   input未定義は駄目   */
  491.  
  492.      if(fkey == spREADLN)               /* readln関数の時             */
  493.       cspfile(fileattr,pRLN) ;          /*  csp rln                   */
  494. }
  495.  
  496. /*****************************************/
  497. /* nottextread() : テキスト型以外の入力  */
  498. /*****************************************/
  499. static void nottextread(Set fsys,char *fname,attr fattr)
  500. {
  501.   attr bufattr ;                        /* バッファ変数の属性         */
  502.   attr lattr   ;                        /* 退避用                     */
  503.   boolean test ;
  504.   Set ws ;
  505.  
  506.      bufattr.typtr = fattr.typtr->sf.fi.filtype ; /* バッファ変数の型 */
  507.      bufattr.kind    = varbl ;
  508.      bufattr.access  = drct  ;
  509.      bufattr.vlevel  = fattr.vlevel ;
  510.      bufattr.dplmt   = fattr.dplmt  ;
  511.      mkset(&ws,comma,rparent,-1);
  512.      orset(&ws,&fsys) ;
  513.  
  514.      do {
  515.       if(gattr.typtr) 
  516.        if((gattr.access != drct) ||     /* 直接参照でないか            */
  517.           (gattr.typtr->form > power))  /* 配列型､レコード型､ファイル型*/
  518.         loadaddress() ;                 /* の時は、アドレスをのせる   */
  519.       lattr = gattr ;
  520.       gattr = bufattr ;                 /*  バッファ変数のロード      */
  521.       if(gattr.typtr)
  522.        if(gattr.typtr->form <= power)   /* スカラー､範囲､ポインタ､集合*/
  523.         load() ;
  524.        else loadaddress() ;             /* 配列､レコードはloadaddress */
  525.       gattr = lattr   ;
  526.       if(gattr.typtr) {
  527.        if((gattr.typtr == realptr) &&          /* 読む変数がreal      */
  528.           (compatible(bufattr.typtr,intptr))){ /* ﾊﾞｯﾌｧ変数が整数型の */
  529.         gen0(iFLT) ;                           /* 実数に変換 flt命令  */
  530.         gattr.typtr = realptr ;
  531.        }
  532.  
  533.        if(assigncompati(gattr.typtr,bufattr.typtr)) /* 代入可能ﾁｪｯｸ   */
  534.         switch(gattr.typtr->form) {     /* 型によって振り分ける       */
  535.          case scalar   :
  536.          case subrange :
  537.            checkbounds(gattr.typtr,17) ;/* 上限･下限のチェック        */ 
  538.            store(gattr) ;
  539.            break ;
  540.          case pointer  :
  541.            store(gattr) ;
  542.            break ;
  543.          case power :
  544.            checkbounds(lattr.typtr,71) ;/* 上限･下限のチェック        */
  545.            store(gattr) ;
  546.            break ;
  547.          case arrays  :
  548.          case records :
  549.            gen2t(iMOV,nil,1,gattr.typtr->size) ;
  550.            break ;
  551.          case files :
  552.            pcerr(116,fname) ;           /* 標準手続きの引数誤り       */
  553.         }
  554.        else pcerr(116,fname) ;          /* 代入可能でない場合         */
  555.  
  556.        cspfile(fattr,pGET)  ;           /* csp get                    */
  557.       }
  558.  
  559.       if(test = (sy == comma)) {
  560.        genlda(level-bufattr.vlevel,bufattr.dplmt) ; /* ﾊﾞｯﾌｧ変数ｱﾄﾞﾚｽ */
  561.        insymbol() ;
  562.        variable(ws) ;                 /* 次の出力対象式               */
  563.       }
  564.      } while(test) ;                  /* , なら繰り返す               */
  565. }
  566.  
  567. /***************************************/
  568. /* ppage() : page手続きの処理          */
  569. /***************************************/
  570. static void ppage(char* name,Set fsys)
  571. {
  572.   Set  ws    ;
  573.  
  574.      ws = fsys ;
  575.      addset(ws,rparent) ;
  576.  
  577.      if(sy == lparent)  {               /* 引数がある時               */
  578.       insymbol()   ;
  579.       variable(ws) ;                    /* ファイル変数               */
  580.       loadaddress() ;
  581.       if(gattr.typtr != textptr)        /* テキストファイルでなければ */
  582.        pcerr(116,name) ;                /* 標準手続きの引数誤り       */
  583.       if(sy == rparent) insymbol() ;
  584.       else pcerr(4,"") ;                /* )がない                    */
  585.      }
  586.      else {                             /* 引数がない時               */
  587.       if(!defineoutput) pcerr(116,name);/* outputファイル未定義       */
  588.       genlda(level-1,outputadr) ;       /* outputアドレス             */
  589.      }
  590.  
  591.      gencsp(pPGE) ;                     /* csp pge                    */
  592. }
  593.  
  594. /***********************************************************/
  595. /* pgetputrstrwt() : get/put/reset/rewrite手続きの処理     */
  596. /***********************************************************/
  597. static void pgetputrstrwt(char *name,Set fsys,stdpf fkey)
  598. {
  599.   enum pcdprmnc cspname ;               /* csp命令のオペランド        */
  600.   Set ws ;
  601.  
  602.      ws = fsys ;
  603.      addset(ws,rparent) ;
  604.      variable(ws) ;                     /* ファイル変数               */
  605.      loadaddress() ;
  606.  
  607.      if(gattr.typtr)
  608.       if(gattr.typtr->form != files)    /* ファイル変数でない         */
  609.        pcerr(116,name) ;                /* 標準手続きの引数誤り       */
  610.       else {
  611.        if(gattr.typtr == textptr)       /* テキストファイルの時       */
  612.         switch(fkey) {
  613.          case spGET    : cspname = pTGT ; break ;
  614.          case spPUT    : cspname = pTPT ; break ;
  615.          case spRESET  : cspname = pTRS ; break ;
  616.          case spREWRITE: cspname = pTRW ; break ;
  617.         }
  618.        else                             /* テキストファイル以外の時   */  
  619.         switch(fkey) {
  620.          case spGET    : cspname = pGET ; break ;
  621.          case spPUT    : cspname = pPUT ; break ;
  622.          case spRESET  : cspname = pRST ; break ;
  623.          case spREWRITE: cspname = pRWT ; break ;
  624.         }
  625.        gencsp(cspname) ;                /* csp命令の生成              */  
  626.       }
  627. }
  628.  
  629. /***************************************/
  630. /* pnewdis() : new/dispose手続きの処理 */
  631. /***************************************/
  632. static void pnewdis(char *name,Set fsys,stdpf fkey)
  633. {
  634.   stp *lsp = nil;
  635.   stp *lsp1     ;
  636.   stp *lspconst ;                       /* 定数の型                   */
  637.   union valu lval ;                     /* 定数の値                   */
  638.   int lsize = 0 ;                       /* 確保･解放するエリアサイズ  */
  639.   Set ws ;
  640.  
  641.      mkset(&ws,rparent,comma,-1);
  642.      orset(&ws,&fsys) ;
  643.      if(fkey == spNEW) {
  644.       variable(ws)  ;                   /* newは引数変数の処理        */
  645.       loadaddress() ;
  646.      } 
  647.      else {
  648.       expression(ws);                   /* disposeは式が許される　    */
  649.       load() ;
  650.      } 
  651.  
  652.      if(gattr.typtr)
  653.       if(gattr.typtr->form == pointer) {
  654.        if(gattr.typtr->sf.pt.eltype) {  /* 指し示す物の型がある       */
  655.         lsize = gattr.typtr->sf.pt.eltype->size ;
  656.         if(gattr.typtr->sf.pt.eltype->form == records)
  657.          lsp = gattr.typtr->sf.pt.eltype->sf.re.recvar ; /* 可変部    */
  658.        }
  659.       }
  660.       else pcerr(116,name) ;            /* 標準手続きの引数の型に誤り */
  661.  
  662.      while(sy == comma) {               /* 定数の指定がある時         */
  663.       insymbol() ;
  664.       constant(ws,&lspconst,&lval)  ;
  665.       if(string(lspconst) || (lspconst==realptr)) /* 文字列､実数型    */
  666.        pcerr(159,"") ;                  /* 文字列､実数型は指定不可    */
  667.       if(!lsp) pcerr(162,"")  ;        /* 該当する可変要素選択子がない*/
  668.       else if((lsp->form == tagfld) &&
  669.               (lsp->sf.tg.tagtype)) {   /* 可変部がある場合           */
  670.        if(compatible(lsp->sf.tg.tagtype,lspconst)) { /* 型が適合する  */
  671.         if(lsp->sf.tg.tagtype->form == subrange)
  672.          if((lval.ival < lsp->sf.tg.tagtype->sf.su.min) ||
  673.             (lval.ival > lsp->sf.tg.tagtype->sf.su.max))  /* 範囲外   */
  674.           pcerr(162,"") ;              /* 該当する可変要素選択子がない*/
  675.         lsp1 = lsp->sf.tg.fstvar ;
  676.         while(lsp1) {                   /* 該当する可変要素を探す     */
  677.          if(lsp1->sf.vr.varval == lval.ival) {  /* 必ず一致するものがある*/
  678.           lsize = lsp1->size ;
  679.           break ;
  680.          }
  681.          else lsp1 = lsp1->sf.vr.nextvr ;
  682.         }
  683.        }
  684.        else pcerr(162,"") ;             /* 該当する可変要素選択子がない*/
  685.        lsp   = lsp1->sf.vr.subvar ;     /* 配下の可変部               */
  686.       }
  687.       else pcerr(162,"") ;              /* 該当する可変要素選択子がない*/
  688.      }
  689.  
  690.      genldc('i',(long)lsize) ;          /* ldc命令で確保長をload      */
  691.      if(fkey == spNEW) gencsp(pNEW) ;   /* csp new                    */
  692.      else              gencsp(pDIS) ;   /* csp dis                    */
  693. }
  694.  
  695. /***************************************/
  696. /*     ppack() : pack手続きの処理      */
  697. /***************************************/
  698. static void ppack(char *name,Set fsys)
  699. {
  700.   stp *lspuinx=nil;                      /* 詰めなし配列の添え字の型   */
  701.   stp *lspuael=nil;                      /* 詰めなし配列の要素の型     */
  702.   long lmin,lmax  ;
  703.   int  lsize      ;
  704.   Set ws ;
  705.  
  706.      mkset(&ws,comma,rparent,-1);
  707.      orset(&ws,&fsys);
  708.      variable(ws) ;                     /* 詰めなし配列               */
  709.      if(gattr.typtr)
  710.       if((gattr.typtr->form == arrays)  /* 詰めなし配列チェック       */
  711.       && (!gattr.typtr->sf.ar.packed)) {
  712.        lspuinx = gattr.typtr->sf.ar.inxtype;
  713.        lspuael = gattr.typtr->sf.ar.aeltype;
  714.        loadaddress() ;                  /* 転送元アドレスをロード     */
  715.       }
  716.       else pcerr(116,name) ;            /* 標準手続きの引き数の型誤り */
  717.      if(sy == comma) insymbol() ;
  718.  
  719.      expression(ws) ;                   /* 詰めなし配列の添え字式     */
  720.      if(gattr.typtr)
  721.       if((gattr.typtr->form  == scalar)
  722.       && (compatible(gattr.typtr,lspuinx))) { /* 型が適合すること     */
  723.        load() ;                         /* 式の値をロード             */
  724.        convertint(gattr.typtr) ;        /* 必要ならord命令生成        */
  725.        getbounds(lspuinx,&lmin,&lmax) ; /* 添え字の範囲を調べる       */
  726.        if(debug) genchk(intptr,26,lmin,lmax) ; /* chk命令を生成       */
  727.        lsize = lspuael->size ;
  728.        lsize = align(lspuael,lsize) ;   /* 境界合わせ                 */
  729.        genixa(lmin,lsize) ;             /* ixa命令生成                */
  730.       }
  731.       else pcerr(116,name) ;            /* 標準手続きの引き数の型誤り */
  732.      if(sy == comma) insymbol() ;
  733.  
  734.      ws = fsys;
  735.      addset(ws,rparent) ;
  736.      variable(ws) ;                     /* 詰め込み配列               */
  737.      if(gattr.typtr)
  738.       if((gattr.typtr->form == arrays)  /* 詰め込み配列チェック       */
  739.       && (gattr.typtr->sf.ar.packed)
  740.       && (compatible(gattr.typtr->sf.ar.inxtype,lspuinx))
  741.       && (compatible(gattr.typtr->sf.ar.aeltype,lspuael))) {
  742.        loadaddress() ;                  /* 転送先アドレスをロード     */
  743.        gen2t(iMOV,nil,2,gattr.typtr->size) ; /* mov 2命令             */
  744.       } 
  745.       else pcerr(116,name) ;            /* 標準手続きの引き数の型誤り */
  746. }
  747.  
  748. /***************************************/
  749. /*     punpack() : unpack手続きの処理  */
  750. /***************************************/
  751. static void punpack(char *name,Set fsys)
  752. {
  753.   stp *lsppinx=nil;                     /* 詰めあり配列の添え字の型   */
  754.   stp *lsppael=nil;                     /* 詰めあり配列の要素の型     */
  755.   stp *lspuinx=nil;                     /* 詰めなし配列の添え字の型   */
  756.   stp *lspuael=nil;                     /* 詰めなし配列の要素の型     */
  757.   long lmin,lmax  ;
  758.   int  lsize      ;
  759.   int  movleng    ;                     /* 転送長                     */
  760.   Set ws ;
  761.  
  762.      mkset(&ws,comma,rparent,-1);
  763.      orset(&ws,&fsys);
  764.      variable(ws) ;                     /* 詰めあり配列               */
  765.      if(gattr.typtr)
  766.       if((gattr.typtr->form == arrays)  /* 詰めあり配列チェック       */
  767.       && (gattr.typtr->sf.ar.packed)) {
  768.        lsppinx = gattr.typtr->sf.ar.inxtype;
  769.        lsppael = gattr.typtr->sf.ar.aeltype;
  770.        movleng = gattr.typtr->size ;
  771.        loadaddress() ;                  /* 転送元アドレスをロード     */
  772.       }
  773.       else pcerr(116,name) ;            /* 標準手続きの引き数の型誤り */
  774.      if(sy == comma) insymbol() ;
  775.  
  776.      variable(ws) ;                     /* 詰めなし配列               */
  777.      if(gattr.typtr)
  778.       if((gattr.typtr->form == arrays)  /* 詰めなし配列チェック       */
  779.       && (!gattr.typtr->sf.ar.packed)
  780.       && (compatible(gattr.typtr->sf.ar.inxtype,lsppinx))
  781.       && (compatible(gattr.typtr->sf.ar.aeltype,lsppael))) {
  782.        lspuinx = gattr.typtr->sf.ar.inxtype;
  783.        lspuael = gattr.typtr->sf.ar.aeltype;
  784.        loadaddress() ;                  /* 基底アドレスをロード       */
  785.       } 
  786.       else pcerr(116,name) ;            /* 標準手続きの引き数の型誤り */
  787.      if(sy == comma) insymbol() ;
  788.  
  789.      ws = fsys;
  790.      addset(ws,rparent) ;
  791.      expression(ws) ;                   /* 詰めなし配列の添え字式     */
  792.      if(gattr.typtr)
  793.       if((gattr.typtr->form  == scalar)
  794.       && (compatible(gattr.typtr,lspuinx))) { /* 型が適合すること     */
  795.        load() ;                         /* 式の値をロード             */    
  796.        convertint(gattr.typtr) ;        /* 必要ならord命令生成        */
  797.        getbounds(lspuinx,&lmin,&lmax) ; /* 添え字の範囲を調べる       */
  798.        if(debug) {
  799.         genchk(intptr,29,lmin,lmax) ;   /* chk命令を生成              */
  800.         genldc('i',(long)(movleng-1));  /* 転送長-1                   */
  801.         gen0(iADI) ;                    /* 転送後の配列添え字         */
  802.         genchk(intptr,31,lmin,lmax) ;   /* 添え字範囲内か             */
  803.         genldc('i',(long)(movleng-1));
  804.         gen0(iSBI) ;                    /* もとに戻す                 */
  805.        } 
  806.        lsize = lsppael->size ;
  807.        lsize = align(lsppael,lsize) ;   /* 境界合わせ                 */
  808.        genixa(lmin,lsize) ;             /* ixa命令生成                */
  809.        gen2t(iMOV,nil,2,movleng) ;      /* mov 2命令                  */
  810.       } 
  811.       else pcerr(116,name) ;            /* 標準手続きの引き数の型誤り */
  812. }
  813.  
  814. /***************************************/
  815. /*     fabs() : abs関数の処理          */
  816. /***************************************/
  817. static void fabs(char *name)
  818. {
  819.      if(gattr.typtr)
  820.       if(gattr.typtr == intptr)       gen0(iABI) ;  /* integerならabi */
  821.       else if(gattr.typtr == realptr) gen0(iABR) ;  /* real   ならabr */
  822.       else {
  823.        pcerr(125,name) ;                /* 標準関数の引数の型に誤り   */
  824.        gattr.typtr = intptr ;
  825.       }
  826. }
  827.  
  828. /***************************************/
  829. /*     fsqr() : sqr関数の処理          */
  830. /***************************************/
  831. static void fsqr(char *name)
  832. {
  833.      if(gattr.typtr)
  834.       if(gattr.typtr == intptr)       gen0(iSQI) ;  /* integerならsqi */
  835.       else if(gattr.typtr == realptr) gen0(iSQR) ;  /* real   ならsqr */
  836.       else {
  837.        pcerr(125,name) ;                /* 標準関数の引数の型に誤り   */
  838.        gattr.typtr = intptr ;
  839.       }
  840. }
  841.  
  842. /***************************************/
  843. /*    ftrunc() : trunc関数の処理       */
  844. /***************************************/
  845. static void ftrunc(char *name)
  846. {
  847.      if(gattr.typtr)
  848.       if(gattr.typtr == realptr) gen0(iTRC) ; /* real ならtrc         */
  849.       else pcerr(125,name) ;            /* 標準関数の引数の型に誤り   */
  850.      gattr.typtr = intptr ;
  851. }
  852.  
  853. /***************************************/
  854. /*    fround() : round関数の処理       */
  855. /***************************************/
  856. static void fround(char *name)
  857. {
  858.      if(gattr.typtr)
  859.       if(gattr.typtr == realptr) gen0(iROU) ; /* real ならrou         */
  860.       else pcerr(125,name) ;            /* 標準関数の引数の型に誤り   */
  861.      gattr.typtr = intptr ;
  862. }
  863.  
  864. /***************************************/
  865. /*     fodd() : odd関数の処理          */
  866. /***************************************/
  867. static void fodd(char *name)
  868. {
  869.      if(gattr.typtr)
  870.       if(gattr.typtr == intptr) gen0(iODD) ; /* integerならodd        */
  871.       else pcerr(125,name) ;            /* 標準関数の引数の型に誤り   */
  872.      gattr.typtr = boolptr ;
  873. }
  874.      
  875. /***************************************/
  876. /*     ford() : ord関数の処理          */
  877. /***************************************/
  878. static void ford(char *name)
  879. {
  880.      if(gattr.typtr)
  881.       if((gattr.typtr->form <= subrange) /* スカラ、部分範囲型         */
  882.       && (gattr.typtr != realptr))       /* realでない時               */ 
  883.        convertint(gattr.typtr) ;         /* 必要ならばord命令を生成    */
  884.       else pcerr(125,name) ;             /* 標準関数の引数の型に誤り   */
  885.      gattr.typtr = intptr ;
  886. }
  887.  
  888. /***************************************/
  889. /*     fchr() : chr関数の処理          */
  890. /***************************************/
  891. static void fchr(char *name)
  892. {
  893.      if(gattr.typtr)
  894.       if(gattr.typtr == intptr) gen0(iCHR) ; /* integerなら chr命令   */
  895.       else pcerr(125,name) ;            /* 標準関数の引数の型に誤り   */
  896.      gattr.typtr = charptr ;
  897. }
  898.  
  899. /***************************************/
  900. /* fpredsucc() : pred / succ関数の処理 */
  901. /***************************************/
  902. static void fpredsucc(char *name,stdpf fkey)
  903. {
  904.      if(gattr.typtr)
  905.       if(gattr.typtr->form == scalar)   /* 引数はスカラのこと         */
  906.        if(fkey == sfSUCC) gen1t(iINC,gattr.typtr,1) ; /* succならinc  */
  907.        else               gen1t(iDEC,gattr.typtr,1) ; /* predならdec  */
  908.       else pcerr(125,name) ;            /* 標準関数の引数の型に誤り   */
  909. }
  910.  
  911. /***************************************/
  912. /* feofeoln() : eof,eoln関数の処理     */
  913. /***************************************/
  914. static void feofeoln(char *name,Set fsys,stdpf fkey)
  915. {
  916.      if(sy == lparent) {                /* 引数がある時               */
  917.       insymbol()   ;          
  918.       variable(fsys) ;                  /* ファイル変数の処理         */
  919.       if(sy == rparent) insymbol() ;
  920.       else pcerr(4,"") ;                /* ) がない                   */
  921.      }
  922.      else {                             /* 引数がない時               */
  923.       if(!defineinput) pcerr(300,name); /*  input未定義の時は駄目     */
  924.       gattr.typtr = textptr ;
  925.       gattr.kind  = varbl   ;
  926.       gattr.access = drct ;
  927.       gattr.vlevel = 1      ;
  928.       gattr.dplmt  = inputadr ;
  929.      }
  930.  
  931.      loadaddress() ;                    /* バッファアドレスのload     */
  932.      
  933.      if(gattr.typtr)
  934.       if((gattr.typtr->form != files) ||/* 引数の型はfile型でない     */
  935.          ((fkey==sfEOLN) && (gattr.typtr!=textptr)))
  936.                                         /* eolnの時はtext型しか駄目   */
  937.        pcerr(125,name) ;                /* 標準関数の引数の型に誤り   */
  938.  
  939.      (fkey == sfEOLN) ? gencsp(pEOL) : gencsp(pEOF) ; /* csp eol/ csp/eof*/
  940.  
  941.      gattr.typtr = boolptr ;
  942. }
  943.  
  944. /***************************************/
  945. /* fcalc(): 算術関数の処理             */
  946. /***************************************/
  947. static void fcalc(char *name,stdpf fkey)
  948. {
  949.   enum pcdprmnc lmnc;                   /* csp命令のオペランド        */
  950.   
  951.      if(gattr.typtr) {
  952.       if(gattr.typtr == intptr) {       /* 引数がinteger              */
  953.        gen0(iFLT) ;                     /* 引数をrealに変換           */
  954.        gattr.typtr = realptr ;
  955.       }
  956.       else if(gattr.typtr != realptr)
  957.        pcerr(125,name) ;                /* 標準関数の引数の型に誤り   */
  958.       switch(fkey) {
  959.        case sfSIN    : lmnc = pSIN; break;
  960.        case sfCOS    : lmnc = pCOS; break;
  961.        case sfEXP    : lmnc = pEXP; break;
  962.        case sfSQRT   : lmnc = pSQT; break;
  963.        case sfLN     : lmnc = pLOG; break;
  964.        case sfARCTAN : lmnc = pATN; break;
  965.       }
  966.       gencsp(lmnc) ;
  967.      }
  968. }
  969.  
  970. /***************************************/
  971. /* variable() : 変数引数の処理         */
  972. /***************************************/
  973. static void variable(Set fsys)
  974. {
  975.   ctp *lcp ;
  976.   Set ws;
  977.  
  978.      if(sy == ident) {                  /* 引数が名前の時             */
  979.       mkset(&ws,vars,field,-1);
  980.       lcp = searchid(ws) ;              /* 変数､フィールド名から探す  */
  981.       insymbol() ;
  982.      }
  983.      else {
  984.       pcerr(2,"") ;                     /* 名前がない                 */
  985.       lcp = uvarptr ;                   /* 未定義変数用の名前エリア   */
  986.      }
  987.      selector(fsys,lcp) ;
  988. }
  989.  
  990. /*****************************************/
  991. /* enterstdf() : 標準手続き･関数名の登録 */
  992. /*****************************************/
  993. void enterstdpf(void)
  994. {
  995.      enterstdpf_sub("write"   ,proc,nilptr,spWRITE)   ;  /* write     */
  996.      enterstdpf_sub("writeln" ,proc,nilptr,spWRITELN) ;  /* writeln   */
  997.      enterstdpf_sub("read"    ,proc,nilptr,spREAD)    ;  /* read      */
  998.      enterstdpf_sub("readln"  ,proc,nilptr,spREADLN)  ;  /* readln    */
  999.      enterstdpf_sub("page"    ,proc,nilptr,spPAGE)    ;  /* page      */
  1000.      enterstdpf_sub("get"     ,proc,nilptr,spGET)     ;  /* get       */
  1001.      enterstdpf_sub("put"     ,proc,nilptr,spPUT)     ;  /* put       */
  1002.      enterstdpf_sub("reset"   ,proc,nilptr,spRESET)   ;  /* reset     */
  1003.      enterstdpf_sub("rewrite" ,proc,nilptr,spREWRITE) ;  /* rewrite   */
  1004.      enterstdpf_sub("new"     ,proc,nilptr,spNEW)     ;  /* new       */
  1005.      enterstdpf_sub("dispose" ,proc,nilptr,spDISPOSE) ;  /* dispose   */
  1006.      enterstdpf_sub("pack"    ,proc,nilptr,spPACK)    ;  /* pack      */
  1007.      enterstdpf_sub("unpack"  ,proc,nilptr,spUNPACK)  ;  /* unpack    */
  1008.  
  1009.      enterstdpf_sub("abs"     ,func,nilptr ,sfABS)    ;  /* abs       */
  1010.      enterstdpf_sub("sqr"     ,func,nilptr ,sfSQR)    ;  /* sqr       */
  1011.      enterstdpf_sub("trunc"   ,func,intptr ,sfTRUNC)  ;  /* trunc     */
  1012.      enterstdpf_sub("round"   ,func,intptr ,sfROUND)  ;  /* round     */
  1013.      enterstdpf_sub("odd"     ,func,boolptr,sfODD)    ;  /* odd       */
  1014.      enterstdpf_sub("ord"     ,func,intptr ,sfORD)    ;  /* ord       */
  1015.      enterstdpf_sub("chr"     ,func,charptr,sfCHR)    ;  /* chr       */
  1016.      enterstdpf_sub("pred"    ,func,nilptr ,sfPRED)   ;  /* pred      */
  1017.      enterstdpf_sub("succ"    ,func,nilptr ,sfSUCC)   ;  /* succ      */
  1018.      enterstdpf_sub("eoln"    ,func,boolptr,sfEOLN)   ;  /* eoln      */
  1019.      enterstdpf_sub("eof"     ,func,boolptr,sfEOF)    ;  /* eof       */
  1020.      enterstdpf_sub("sin"     ,func,realptr,sfSIN)    ;  /* sin       */
  1021.      enterstdpf_sub("cos"     ,func,realptr,sfCOS)    ;  /* cos       */
  1022.      enterstdpf_sub("exp"     ,func,realptr,sfEXP)    ;  /* exp       */
  1023.      enterstdpf_sub("sqrt"    ,func,realptr,sfSQRT)   ;  /* sqrt      */
  1024.      enterstdpf_sub("ln"      ,func,realptr,sfLN)     ;  /* ln        */
  1025.      enterstdpf_sub("arctan"  ,func,realptr,sfARCTAN) ;  /* arctan    */
  1026. }
  1027.  
  1028. /****************************************************/
  1029. /*  enterdtdpf_sub() : 標準手続き･関数名の登録サブ  */
  1030. /****************************************************/
  1031. static void enterstdpf_sub(char *name,enum idclass pf,
  1032.                            stp *typeptr,stdpf pfid)
  1033. {
  1034.   ctp *cp ;
  1035.  
  1036.      cp = mkctp(name,pf,typeptr,nil);   /* 名前エリアを確保する       */
  1037.      cp->n.pf.pfdeckind = standard    ; /* 標準関数                   */
  1038.      cp->n.pf.sd.key    = pfid        ; /* 識別子                     */
  1039.      enterid(cp)                      ; /* 名前登録                   */
  1040. }
  1041.